;;;; RLlib copyright 2010 Adam White (theroguemonkey@gmail.com)
;;;; Licensed under GNU General Public Licence v2 or later - refer COPYING

(in-package :rllib)

(cffi:defctype ttf-font :pointer)

(cffi:defcfun ("TTF_Init" ttf-init) :void)

(cffi:defcfun ("TTF_OpenFont" ttf-open) ttf-font
  (file :string)
  (ptsize :int))

(cffi:defcfun ("TTF_OpenFontIndex" ttf-open-index) ttf-font
  (file :string)
  (ptsize :int)
  (index :long))

(cffi:defbitfield ttf-style
   (:style-normal #x00)
   (:style-bold #x01)
   (:style-italic #x02)
   (:style-underline #x04)
   (:style-strikethrough #x08))

(cffi:defcfun ("TTF_GetFontStyle" ttf-style) ttf-style
  (font ttf-font))

(cffi:defcfun ("TTF_SetFontStyle" %ttf-set-style) :void
  (font ttf-font)
  (style ttf-style))

(defun (setf ttf-style) (val font)
  (%ttf-set-style font val)
  val)

(cffi:defcfun ("TTF_GetFontOutline" ttf-font-outline) :int
  (font ttf-font))

(cffi:defcfun ("TTF_SetFontOutline" %ttf-set-font-outline) :void
  (font ttf-font)
  (outline :int))

(defun (setf ttf-font-outline) (val font)
  (%ttf-set-font-outline font val)
  val)

(cffi:defcenum ttf-hinting
  (:ttf-hinting-normal 0)
  (:ttf-hinting-light 1)
  (:ttf-hinting-mono 2)
  (:ttf-hinting-none 3))

(cffi:defcfun ("TTF_GetFontHinting" ttf-font-hinting) ttf-hinting
  (font ttf-font))

(cffi:defcfun ("TTF_SetFontHinting" %ttf-set-font-hinting) :void
  (font ttf-font)
  (hinting ttf-hinting))

(defun (setf ttf-font-hinting) (val font)
  (%ttf-set-font-hinting font val)
  val)

(cffi:defcfun ("TTF_FontHeight" ttf-height) :int
  (font ttf-font))

(cffi:defcfun ("TTF_FontAscent" ttf-ascent) :int
  (font ttf-font))

(cffi:defcfun ("TTF_FontDescent" ttf-descent) :int
  (font  ttf-font))

(cffi:defcfun ("TTF_FontLineSkip" ttf-line-skip) :int
  (font ttf-font))

(cffi:defcfun ("TTF_GetFontKerning" ttf-font-kerning) :boolean
  (font ttf-font))

(cffi:defcfun ("TTF_SetFontKerning" %ttf-set-font-kerning) :void
  (font ttf-font)
  (allowed :int))

(defun (setf ttf-font-kerning) (val font)
  (%ttf-set-font-kerning font (if val 1 0))
  val)

(cffi:defcfun ("TTF_FontFaces" ttf-faces) :long
  (font ttf-font))

(cffi:defcfun ("TTF_FontFaceIsFixedWidth" ttf-fixed-width-p) :boolean
  (font ttf-font))

(cffi:defcfun ("TTF_FontFaceFamilyName" ttf-family-name) :string
  (font ttf-font))

(cffi:defcfun ("TTF_FontFaceStyleName" ttf-style-name) :string
  (font ttf-font))

(cffi:defcfun ("TTF_GlyphIsProvided" ttf-glyph-provided-p) :boolean
  (font ttf-font)
  (character :uint16))

(cffi:defcfun ("TTF_GlyphMetrics" %ttf-glyph-metrics) :int
  (font ttf-font)
  (ch :uint16)
  (minx :pointer)
  (maxx :pointer)
  (miny :pointer)
  (maxy :pointer)
  (advance :pointer))

(cffi:defcfun ("TTF_SizeText" %ttf-size-text) :int
  (font ttf-font)
  (text :string)
  (w :pointer)
  (h :pointer))

(cffi:defcfun ("TTF_SizeUTF8" %ttf-size-utf8) :int
  (font ttf-font)
  (text :string)
  (w :pointer)
  (h :pointer))

(cffi:defcfun ("TTF_SizeUNICODE" %ttf-size-unicode) :int
  (font ttf-font)
  (text :string)
  (w :pointer)
  (h :pointer))

(defun ttf-size-text (font string)
  (cffi:with-foreign-object (ints :int 2)
    (%ttf-size-text font string ints (cffi:inc-pointer ints (cffi:foreign-type-size :int)))
    (list (cffi:mem-aref ints :int 0) (cffi:mem-aref ints :int 1))))

(defun ttf-size-utf8 (font string)
  (cffi:with-foreign-object (ints :int 2)
    (%ttf-size-utf8 font string ints (cffi:inc-pointer ints (cffi:foreign-type-size :int)))
    (list (cffi:mem-aref ints :int 0) (cffi:mem-aref ints :int 1))))

(defun ttf-width-utf8 (font string)
  (cffi:with-foreign-object (width :int)
    (%ttf-size-utf8 font string width (cffi:null-pointer))  
    (cffi:mem-ref width :int)))

(defun ttf-size-unicode (font string)
  (cffi:with-foreign-object (ints :int 2)
    (%ttf-size-unicode font string ints (cffi:inc-pointer ints (cffi:foreign-type-size :int)))
    (list (cffi:mem-aref ints :int 0) (cffi:mem-aref ints :int 1))))


(defmacro %ttf-helper-render-maker (text strings types)
  (labels ((make-l-name (name type)
	     (intern (string-upcase (strcat "%ttf-render-" name "-" type))  #. (find-package :rllib)))
	   (make-g-name (name type)
	     (intern (string-upcase (strcat "ttf-render-" name "-" type)) #. (find-package :rllib)))
	   (make-c-name (name type)
	     (strcat "C_TTF_Render" name "_" type))
	   (make-ttf-function (name type)
	     (let ((c-name (make-c-name name type))
		   (l-name (make-l-name name type))
		   (g-name (make-g-name name type)))	       
	       `(progn
		  (cffi:defcfun (,c-name ,l-name) %sdl-surface
		    (font ttf-font)
		    (text ,text)
		    (colour %sdl-color))
		  (defgeneric ,g-name (font text color)
		    (:method (font text (color colour))
		      (with-color (c color)
			(,l-name font text c)))
		    (:method (font text color)
		      (,l-name font text color)))))))
    `(progn
       ,@(loop for (name . type) in (map-product #'cons strings types) collect (make-ttf-function name type)))))


(%ttf-helper-render-maker :string ("Text" "UTF8") ("Solid" "Shaded" "Blended"))
(%ttf-helper-render-maker :pointer ("UNICODE") ("Solid" "Shaded" "Blended"))
(%ttf-helper-render-maker :uint16 ("Glyph") ("Solid" "Shaded" "Blended"))

(cffi:defcfun ("TTF_CloseFont" ttf-close) :void
  (font ttf-font))

(cffi:defcfun ("TTF_Quit" ttf-quit) :void)

(cffi:defcfun ("TTF_WasInit" ttf-init-p) :boolean)

